home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / elecTemplates.tcl < prev    next >
Encoding:
Text File  |  1999-02-01  |  17.0 KB  |  594 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "elecTemplates.tcl"
  6.  #                    created: 24/2/97 {1:34:29 pm}    
  7.  #                  last update: 1/2/1999 {11:18:50 pm}    
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #  Routines for electric insertions, and keeping track of template
  15.  #  positions.    
  16.  # ###################################################################
  17.  ##
  18.  
  19. alpha::feature betterTemplates 9.2.1 global {
  20.     alpha::package require elecBindings 9.0
  21.     alpha::useElectricTemplates
  22. } {
  23.     lunion varPrefs(Electrics) [list "Better Templates:" stopNavigationMsgOff \
  24.       templateStopColor maxTemplateNesting \
  25.       TemplatePrompts TemplateWrappers]
  26.     # The colour used for template stops inserted into the text.
  27.     newPref var templateStopColor 4 global "" alpha::basiccolors varindex
  28.     # If the level of nesting of template stops exceeds this value,
  29.     # we clear all template stops.
  30.     newPref var maxTemplateNesting 5
  31.     ## 
  32.      # The format of the template stops:
  33.      #     (a) just use bullets
  34.      #     (b) use bullets but signal the name in the status window
  35.      #     (c) insert names into the window with the bullets
  36.      #     (d) insert names and highlight into the window with the bullets
  37.      ##
  38.     newPref var TemplatePrompts 1 global "" [list {Just use bullets} \
  39.       {Use bullets and status window prompt} {Put prompts in the text} \
  40.       {Highlight prompts in the text}] index
  41.     # Visual appearance of templates in the text
  42.     newPref var TemplateWrappers 0 global ring::_changeTemplateWrappers \
  43.       [list {<Angle brackets>} {“Curly quotes”} {«Curly brackets»} ] index
  44.     # Don't bother with the basic 'hit tab to go to next stop...' message
  45.     newPref flag stopNavigationMsgOff 0 global ring::setTemplateMessage
  46.     # so we force a reload of this file when necessary
  47.     if {[info commands ring::setTemplateMessage] != ""} {
  48.     rename ring::setTemplateMessage ""
  49.     }
  50.     ring::setTemplateMessage
  51.     # setup template wrappers
  52.     ring::_changeTemplateWrappers
  53.     # call on close to clear the stop ring.
  54.     hook::register closeHook ring::unsetName    
  55. } {
  56.     hook::deregister closeHook ring::unsetName
  57.     # source old code since we over-rode it below.
  58.     source [file join $HOME Tcl SystemCode templates.tcl]
  59. } maintainer {
  60.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  61. } uninstall this-file help {file "ElecCompletions Help"}
  62.  
  63. # we don't want to be auto-loaded unless we're active.
  64. #if {![package::active betterTemplates]} { 
  65. #    alertnote "Something's trying to auto-load the betterTemplates extension\
  66. #      but it's not active!"
  67. #    return 
  68. #}
  69.  
  70. # indicates we're a better ring
  71. proc ring::type {} { return 1 }
  72.  
  73. proc ring::isNested {p} {
  74.     if {![catch {ring::minmax} mm] \
  75.       && [pos::compare $p >= [lindex $mm 0]] \
  76.       && [pos::compare $p <= [lindex $mm 1]]} {
  77.     return 1
  78.     } else {
  79.     ring::clear
  80.     return 0
  81.     }
  82. }
  83.  
  84. proc ring::nestedPos {pos} {
  85.     if {[catch {
  86.     set p [tmark::getPositions {nestStart nestEnd}]
  87.     if {[pos::compare $pos < [lindex $p 0]]} { return -1 }
  88.     if {[pos::compare $pos > [lindex $p 1]]} { return -1 }
  89.     }]} { return -1 }
  90.     set positions [ring::orderAndPositions]
  91.     if {$positions == "" || [pos::compare $pos < [lindex $positions 0]] \
  92.       || [pos::compare $pos >= [lindex $positions end]]} {
  93.     return -1
  94.     } else {
  95.     set i 0
  96.     while {[pos::compare $pos >= [lindex $positions $i]]} {incr i}
  97.     return $i
  98.     }
  99. }
  100.  
  101. proc ring::minmax {} {
  102.     return [tmark::getPositions {nestStart nestEnd}]
  103. }
  104. proc ring::getlist {} {
  105.     # get a local reference to the window's stopRing
  106.     upvar \#0 __elecRing([ring::winName]) s
  107.     if {![info exists s]} {
  108.     return [ring::clear]
  109.     }
  110.     set s
  111. }
  112.  
  113. proc ring::clear {} {
  114.     set x [ring::winName]
  115.     # get a local reference to the window's stopRing
  116.     upvar \#0 __elecRing($x) s
  117.     if {[info exists s] && $s != ""} {
  118.     ring::_ensure_no_bullets $s
  119.     }
  120.     set s ""
  121.     upvar \#0 __elecRingPrompts$x w
  122.     if {[info exists w]} {unset w}
  123.     global __elecNestingLevel __elecLastStop
  124.     set __elecNestingLevel($x) 0
  125.     set __elecLastStop($x) ""
  126.     
  127.     removeTMark "nestStart"
  128.     removeTMark "nestEnd"
  129. }
  130.  
  131. proc ring::unsetName {name} {
  132.     ring::unseti [join [file tail $name] ""]
  133. }
  134.  
  135. proc ring::unseti {x} {
  136.     global __elecRing __elecNestingLevel __elecLastStop __elecRingPrompts$x
  137.     if {[info exists __elecRing($x)]} {
  138.     unset __elecRing($x)
  139.     }
  140.     if {[info exists __elecNestingLevel($x)]} {
  141.     unset __elecNestingLevel($x)
  142.     }
  143.     if {[info exists __elecLastStop($x)]} {
  144.     unset __elecLastStop($x)
  145.     }
  146.     if {[info exists __elecRingPrompts$x]} {
  147.     unset __elecRingPrompts$x
  148.     }
  149. }
  150.  
  151. proc ring::_ensure_no_bullets {stops} {
  152.     message "Deleting non-nested prompts…"
  153.     createTMark "_deleting_" [getPos]
  154.     foreach stop $stops {
  155.     if {![catch {tmark::getPos $stop} p]} {
  156.         ring::_deleteBullet $p
  157.         removeTMark $stop
  158.     }    
  159.     }
  160.     message ""
  161.     gotoTMark "_deleting_"
  162.     removeTMark "_deleting_"
  163. }
  164.  
  165. ## 
  166.  # -------------------------------------------------------------------------
  167.  # 
  168.  # "ring::replaceStopMatches" --
  169.  # 
  170.  #  Replace all stops which match 'stoppat' (a simple glob like pattern)
  171.  #  with the text '$text'.  The stops are permanently deleted.
  172.  # -------------------------------------------------------------------------
  173.  ##
  174. proc ring::replaceStopMatches {stoppat text} {
  175.     # get a local reference to the window's stopRing
  176.     set x [ring::winName]
  177.     upvar \#0 __elecRing($x) s
  178.     if {[info exists s]} {
  179.     placeBookmark
  180.     upvar \#0 __elecRingPrompts$x w
  181.     set i 0
  182.     foreach stop $s {
  183.         if {[string match $stoppat $w($stop)]} {
  184.         if {![catch {tmark::getPos $stop} p]} {
  185.             if {[ring::_deleteBullet $p]} {
  186.             insertText $text
  187.             }
  188.             removeTMark $stop
  189.             set s [lreplace $s $i $i]
  190.             incr i -1
  191.         }    
  192.         }
  193.         incr i
  194.     }    
  195.     returnToBookmark
  196.     } else {
  197.     ring::clear
  198.     } 
  199. }
  200.  
  201. proc ring::winName {} { return [join [win::CurrentTail] ""] }
  202.  
  203. proc ring::order {} {
  204.     # get a local reference to the window's stopRing
  205.     upvar \#0 __elecRing([ring::winName]) s
  206.     if {[info exists s]} {
  207.     for {set i 0} {$i <100} {incr i} {
  208.         if {[set lpos [lsearch -exact $s stop0:${i}]] != -1 } {
  209.         set s [concat [lrange $s $lpos end] [lrange $s 0 [incr lpos -1]]]
  210.         return $s
  211.         }
  212.     }
  213.     } else {
  214.     ring::clear
  215.     } 
  216. }
  217.  
  218. proc ring::orderAndPositions {} {
  219.     # get a local reference to the window's stopRing
  220.     upvar \#0 __elecRing([ring::winName]) s
  221.     if {[info exists s] && ([string trim $s] != {}) } {
  222.     set positions [tmark::getPositions $s]
  223.     set max -1
  224.     set idx 0
  225.     set lpos -1
  226.     foreach st $s {
  227.         if {[pos::compare [set p [lindex $positions $idx]] > $max]} {
  228.         set max $p
  229.         set lpos $idx
  230.         }
  231.         incr idx
  232.     }
  233.     set s [concat [lrange $s [expr {$lpos +1}] end] [lrange $s 0 $lpos]]
  234.     set positions [concat [lrange $positions [expr {$lpos +1}] end] \
  235.       [lrange $positions 0 $lpos]]
  236.     return $positions
  237.     } else {
  238.     ring::clear
  239.     return ""
  240.     } 
  241. }
  242.  
  243. ## 
  244.  # -------------------------------------------------------------------------
  245.  # 
  246.  # "ring::_deleteBullet" --
  247.  # 
  248.  #  Deletes the bullet and a following tag-prompt.  The mark moves to the
  249.  #  location of the deleted text (side-effect).  Returns '1' if the deletion
  250.  #  was successful, else '0'.
  251.  # -------------------------------------------------------------------------
  252.  ##
  253. proc ring::_deleteBullet {p {h 0}} {
  254.     global elecStopMarker
  255.     if {[lookAt $p] == $elecStopMarker} {
  256.     global ring::_tstart ring::_tmatch
  257.     if {[lookAt [pos::math $p + 1]] == ${ring::_tstart} } {
  258.         set    ppos [search -s -f 1 -r 1 -l [pos::math $p + 80] -n ${ring::_tmatch} $p]
  259.         if {[pos::compare [lindex $ppos 0] == $p]} {
  260.         if {$h} {
  261.             eval select $ppos
  262.         } else {
  263.             eval deleteText $ppos
  264.         }
  265.         return 1
  266.         }
  267.     }
  268.     deleteText $p [pos::math $p + 1]
  269.     return 1
  270.     }
  271.     return 0
  272. }
  273.  
  274. proc ring::_goto {rest} {
  275.     global __elecLastStop ring::_templateMessage TemplatePrompts
  276.     set x [ring::winName]
  277.     gotoTMark [set __elecLastStop($x) $rest]
  278.     # remove the stop '•' plus optional prompt-tag.
  279.     ring::_deleteBullet [getPos] [expr {$TemplatePrompts == 3}]
  280.     if {$TemplatePrompts} {
  281.     upvar \#0 __elecRingPrompts$x w
  282.     if {$w($rest) != ""} {
  283.         message "Fill in '$w($rest)'${ring::_templateMessage}"
  284.     } else {
  285.         message "Fill in template stop${ring::_templateMessage}"
  286.     }
  287.     }
  288. }
  289.  
  290. proc ring::nth {} {
  291.     # get a local reference to the window's stopRing
  292.     set x [ring::winName]
  293.     upvar \#0 __elecRing($x) s
  294.     upvar \#0 __elecRingPrompts$x w
  295.     foreach f $s {
  296.     if {$w($f) != ""} {
  297.         lappend l "$f -- $w($f)"
  298.     } else {
  299.         lappend l "$f -- (no prompt)"
  300.     }
  301.     }
  302.     if {![info exists l]} { beep; message "No template stops exist." }
  303.     set item [lindex [listpick -p "Pick a stop (listed from current pos)…" $l] 0]
  304.     ring::goTo $item
  305. }
  306. proc ring::goTo {stop} {
  307.     # get a local reference to the window's stopRing
  308.     upvar \#0 __elecRing([ring::winName]) s
  309.     if {[info exists s]} {
  310.     if { [set lpos [lsearch -exact $s $stop]] != -1 } {
  311.         set s [concat [lrange $s $lpos end] [lrange $s 0 [incr lpos -1]]]
  312.         ring::_goto $stop
  313.     }
  314.     } else {
  315.     ring::clear
  316.     } 
  317. }
  318.  
  319. ## 
  320.  # -------------------------------------------------------------------------
  321.  # 
  322.  # "ring::TMarkAt" --
  323.  # 
  324.  #  Is the template stop with prompt 'name' at position 'pos'.  The 'name'
  325.  #  is the name of the enclosed prompt as in '•environment name•', but
  326.  #  without the bullets.  It is matched via 'string match'.
  327.  # -------------------------------------------------------------------------
  328.  ##
  329. proc ring::TMarkAt {name pos} {
  330.     set stop [tmark::isAt $pos]
  331.     if {$stop != ""} {
  332.     set x [ring::winName]
  333.     upvar \#0 __elecRingPrompts$x w
  334.     return [string match $name $w($stop)]
  335.     } else {
  336.     return 0
  337.     }
  338. }
  339.  
  340. proc ring::+ {} {
  341.     # get a local reference to the window's stopRing
  342.     upvar \#0 __elecRing([ring::winName]) s
  343.     set first [lindex $s 0]
  344.     set s [lreplace $s 0 0]
  345.     lappend s $first
  346.     set next [lindex $s 0]
  347.     ring::_goto $next
  348. }
  349. proc ring::- {} {
  350.     # get a local reference to the window's stopRing
  351.     upvar \#0 __elecRing([ring::winName]) s
  352.     #set end [expr {[llength $s] - 1}]
  353.     set last [lindex $s end]
  354.     set s [lreplace $s end end]
  355.     set s [linsert $s 0 $last]
  356.     ring::_goto $last
  357. }
  358.  
  359. proc ring::deleteBulletAndMove {} {
  360.     ring::_deleteBullet [getPos]
  361.     ring::+
  362. }
  363.  
  364. proc ring::deleteStopAndMove {} {
  365.     ring::_deleteStop
  366.     upvar \#0 __elecRing([ring::winName]) s
  367.     ring::_goto [lindex $s 0]
  368. }
  369.  
  370. proc ring::deleteStop {} {
  371.     ring::_deleteStop
  372. }
  373.  
  374. proc ring::_deleteStop {} {
  375.     global __elecLastStop
  376.     set x [ring::winName]
  377.     # get a local reference to the window's stopRing
  378.     upvar \#0 __elecRing($x) s
  379.     set l [lsearch -exact $s $__elecLastStop($x)]
  380.     if {$l != -1 } {
  381.     global TemplatePrompts
  382.     if {$TemplatePrompts == 3} {
  383.         ring::_deleteBullet [getPos]
  384.     }
  385.     set s [lreplace $s $l $l]
  386.     removeTMark $__elecLastStop($x)
  387.     set __elecLastStop($x) ""
  388.     }
  389. }
  390.  
  391. proc ring::insert {rest {goto 1}} {
  392.     global __elecNestingLevel __elecCurrentNesting maxTemplateNesting \
  393.       elecStopMarker
  394.     # get a local reference to the window's stopRing
  395.     set x [ring::winName]
  396.     upvar \#0 __elecRing($x) s
  397.     # if not nested, clear everything
  398.     if {[set p [ring::nestedPos [getPos]]] == "-1" \
  399.       || [incr __elecNestingLevel($x)] > $maxTemplateNesting } {
  400.     ring::clear
  401.     set p 0
  402.     }
  403.     set _level $__elecNestingLevel($x)
  404.     # preliminaries
  405.     set pos [getPos]
  406.     set ii [set i 0] 
  407.     upvar \#0 __elecRingPrompts$x w
  408.     global __elecPrompts
  409.     if {![info exists __elecPrompts]} {
  410.     set __elecPrompts ""
  411.     }
  412.     # do the stop ring, extracting prompts from '__elecPrompts'
  413.     while {[regexp -indices $elecStopMarker $rest I] == 1} {
  414.     regsub $elecStopMarker $rest "o" rest
  415.     createTMark "stop${_level}:$i" [pos::math $pos + [lindex $I 0]]
  416.     lappend ss "stop${_level}:$i"
  417.     set w(stop${_level}:$i) [lindex $__elecPrompts $i]
  418.     #set __elecPrompts [lrange $__elecPrompts 1 end]
  419.     incr i
  420.     }
  421.     if {$i > 2 || ($i == 2 && $_level == 0)} {
  422.     # store insertion's min and max, if we have more than two stops
  423.     createTMark "nestStart" $pos
  424.     createTMark "nestEnd" [pos::math $pos + [string length $rest]]
  425.     }
  426.     # put the stop ring together
  427.     set s [concat $ss [lrange $s $p end] [lrange $s 0 [expr {$p -1}]]]
  428.     # forget the prompt list (we've stored them in an array)
  429.     unset __elecPrompts
  430.     # goto the first stop we just inserted
  431.     if {$goto} {
  432.     ring::_goto "stop${_level}:${ii}"
  433.     }
  434. }
  435.  
  436.  
  437. proc ring::_changeTemplateWrappers {{flag ""}} {
  438.     global flag::list TemplateWrappers elecStopMarker
  439.     set wrap [lindex [lindex [set flag::list(TemplateWrappers)] 1] $TemplateWrappers]
  440.     global ring::_tstart ring::_tend ring::_tmatch
  441.     set a [string index $wrap 0]
  442.     set b [string index $wrap [expr {[string length $wrap] -1}]]
  443.     
  444.     set "ring::_tstart" $a
  445.     set "ring::_tend" $b
  446.     #     set "ring::_tmatch" "•${a}\[^${a}${b}\]*${b}"
  447.     set "ring::_tmatch" "(${elecStopMarker}${a}\[^${a}${b}]*${b}|${elecStopMarker}${a}(\[^${a}${b}\]*(${a}\[^${a}${b}\]*${b})\[^${a}${b}\]*)*${b})"
  448. }
  449.  
  450. proc ring::setTemplateMessage {} {
  451.     global electricBindings ring::_templateMessage stopNavigationMsgOff
  452.     set ring::_templateMessage [lindex \
  453.       {", press Tab (shift-Tab) to move to the next (previous) stop." \
  454.       ", press ctrl-j (shift-ctrl-j) to move to the next (previous) stop." \
  455.       ", press user-defined keys to move from stop to stop." } \
  456.       $electricBindings]
  457.     if {$stopNavigationMsgOff} {
  458.     set ring::_templateMessage ""
  459.     } 
  460. }
  461.  
  462.  
  463.  
  464. ## 
  465.  # -------------------------------------------------------------------------
  466.  #     
  467.  #    "elec::_Insertion" --
  468.  #    
  469.  #     Insert    a piece    of text, padding on    the    left appropriately.     The text 
  470.  #     should    already    be correctly indented within itself.  
  471.  # -------------------------------------------------------------------------
  472.  ##
  473. proc elec::_Insertion { center args } {
  474.     global __elecPrompts TemplatePrompts elecStopMarker
  475.     set text [join $args ""]
  476.     set pos [getPos]
  477.     regsub -all "\t" $text [text::Tab] text
  478.     if {[regexp "\[\n\r\]" $text]} {
  479.     regsub -all "\[\n\r\]" $text "\r[text::indentTo $pos]" text
  480.     }
  481.     if {[regexp "…" $text]} {
  482.     regsub -all "…" $text [text::halfTab] text
  483.     }
  484.     if {![regexp "•" $text] || ([regexp {^([^•]*)••$} $text "" text])} {
  485.     setMark
  486.     insertText $text
  487.     if {$center} { centerRedraw }
  488.     return
  489.     }
  490.     switch -- $TemplatePrompts {
  491.     0 {
  492.         set t $text
  493.         regsub -all {•[^•]*•} $text $elecStopMarker text
  494.         insertText $text
  495.         while {[regexp {^([^•]*)•([^•]*)•(.*)$} $t "" tt hyper t]} {
  496.         lappend __elecPrompts $hyper
  497.         }
  498.     }
  499.     1 {
  500.         while {[regexp {^([^•]*)•([^•]*)•(.*)$} $text "" tt hyper text]} {
  501.         lappend __elecPrompts $hyper
  502.         append t "${tt}$elecStopMarker"
  503.         lappend colours [list [string length $tt] 1]
  504.         }
  505.         append t $text
  506.     }
  507.     2 -
  508.     3 {
  509.         global ring::_tstart ring::_tend
  510.         while {[regexp {^([^•]*)•([^•]*)•(.*)$} $text "" tt hyper text]} {
  511.         lappend __elecPrompts $hyper
  512.         if {$hyper != ""} {
  513.             append t "${tt}${elecStopMarker}${ring::_tstart}${hyper}${ring::_tend}"
  514.             lappend colours [list [string length $tt] \
  515.               [expr {3 + [string length $hyper]}]]
  516.         } else {
  517.             append t "${tt}${elecStopMarker}"
  518.             lappend colours [list [string length $tt] 1]
  519.         }
  520.         }
  521.         append t $text
  522.     }
  523.     }
  524.     if {$TemplatePrompts} {
  525.     set p $pos
  526.     # we insert in one chunk so undoing is easy.
  527.     insertText $t
  528.     global templateStopColor
  529.     if {$templateStopColor} {
  530.         foreach col $colours {
  531.         set p [pos::math $p + [lindex $col 0]]
  532.         insertColorEscape $p $templateStopColor
  533.         set p [pos::math $p + [lindex $col 1]]
  534.         insertColorEscape $p 0
  535.         }
  536.     }
  537.     
  538.     set text $t
  539.     }
  540.     
  541.     goto $pos
  542.     if {$center} { centerRedraw }
  543.     ring::insert $text
  544. }
  545.  
  546.  
  547. # ◊◊◊◊ possible tab key bindings ◊◊◊◊ #
  548. # note: Also provided by the base Alpha system, these overide when 
  549. # Univs Completions package is in use (these may be more intricate).
  550.  
  551. ## 
  552.  # -------------------------------------------------------------------------
  553.  #     
  554.  #    "bind::IndentOrNextstop" --
  555.  #    
  556.  #     Either    insert a real tab if your mode hasn't defined its electricTab
  557.  #     variable, or jump to the next template    stop (if we're mid-template),
  558.  #     or    indent the current line    correctly.
  559.  # -------------------------------------------------------------------------
  560.  ##
  561. proc bind::IndentOrNextstop {{hard 0}} {
  562.     global electricTab
  563.     if {$hard || !$electricTab} {
  564.     insertActualTab 
  565.     } else {
  566.     global tabNeverIndents
  567.     if {[info exists tabNeverIndents] && $tabNeverIndents} { return [ring::+] }
  568.     if {[ring::isNested [getPos]]} {
  569.         ring::+
  570.     } else {
  571.         bind::IndentLine
  572.     }
  573.     }
  574. }
  575.  
  576. ## 
  577.  # -------------------------------------------------------------------------
  578.  #     
  579.  #    "bind::TabOrComplete" --
  580.  #    
  581.  #     Either    insert a real tab if your mode hasn't defined its electricTab
  582.  #     variable, or invoke the completion mechanism, or indent the current 
  583.  #     line correctly.
  584.  # -------------------------------------------------------------------------
  585.  ##
  586. proc bind::TabOrComplete {{hard 0}} {
  587.     global electricTab
  588.     if {$hard || !$electricTab} {
  589.     insertActualTab 
  590.     } else {
  591.     bind::Completion
  592.     }
  593. }
  594.